rm(list=ls())
library(ScedasticSurrogateSwarmR)
#set.seed(128)
The scedastic surrogate swarm optimizer can be used for large dimensional problems. For example let us establish a neural network with a single hidden layer as our model function.
model_function <-function(params,ls){
parammat <- matrix(params,nrow=3)
l1_w <- parammat[1,]
l1_b <- parammat[2,]
lo_2 <- parammat[3,]
modval<-t(pmax((l1_w%*%t(xdat))+l1_b,((l1_w%*%t(xdat))+l1_b)*0.03))%*%t(t(lo_2))
return(modval)
}
#Equality Constraints
eq <- function(params){
constraints = c(
)
return(constraints)
}
#Inequality Constraints
# of form <= 0
ineq <- function(params){
constraints = c(
)
return(constraints)
}
We can set up our input values in the following manner:
ls = 20 #Layer size
ndat=50
xdat=sort(runif(ndat,-10,10))
ydat = c(sin(0.5*xdat)/2)+0.6
lowlim=rep(-1,3*ls)
highlim=rep(1,3*ls)
Using a Scedastic Surrogate Swarm optimization:
swarm_state <- initialize_swarm(desired_values = ydat,param_len = 3*ls,lowlim=lowlim,highlim=highlim,ineq_w = c(),eq_w = c(),config = swarm.config(swarm_size = ls*2))
for (itt in 1:50){
tempcontrol = swarm.control(poly_w=0.2,stoch_w = 0.01)
swarm_state <- step_swarm(desired_values = ydat,swarm_state,ineq_w = c(),eq_w=c(),config = swarm.config(swarm_size=dim(swarm_state$x.p)[1],num_cluster=1,swarm.control = tempcontrol))
matplot(xdat,swarm_state$pout,type="l",col="grey",xlab = NULL,ylab="value",ylim = c(0,1.2))
points(xdat,ydat)
surrogate_out <- surrogate_model(as.vector(swarm_state$poly_rec),swarm_state$polyouts,swarm_state$centersaves,deg=1)
lines(xdat,surrogate_out,col="blue")
lines(xdat,model_function(as.vector(swarm_state$poly_rec)),col="red")
title("Scedastic Surrogate Swarm Optimization")
legend(par('usr')[2], par('usr')[4], bty='n',
xpd=NA,c("Observed","Modeled","Predicted","Actual"),fill=c("black","grey","blue","red"))
}
print(paste("Number of function evals: ",dim(swarm_state$allxp)[1]))
#> [1] "Number of function evals: 2000"
We can also use the Scedastic Surrogate Swarm package to do non-swarm searching using surrogates:
search_state <- initialize_search(param_len = 3*ls,lowlim=lowlim,highlim=highlim,config = search.config(deg=1))
genstate = F
for (itt in 1:7){
tempconfig = search.config(gen = genstate,deg=1,search_samples = ls*3*2,search_mag=0.1,revert_best = T)
search_state <- step_search(desired_values = ydat,search_state,ineq_w = c(),eq_w=c(),config = tempconfig)
modout = model_function(as.vector(search_state$poly_recs[1,]))
surrogate_out <- surrogate_model(as.vector(search_state$poly_recs[1,]),search_state$polyouts,search_state$centersaves,deg=1)
if (mean(abs((modout-surrogate_out)/modout))>10){
genstate = T
}else{
genstate = F
}
par(oma=c(0, 0, 0, 5))
matplot(xdat,search_state$current_pout,type="l",col="grey",xlab = NULL,ylab="value",ylim = c(0,1.2))
points(xdat,ydat)
lines(xdat,surrogate_out,col="blue")
lines(xdat,model_function(as.vector(search_state$poly_recs[1,])),col="red")
title("Surrogate Search Optimization")
legend(par('usr')[2], par('usr')[4], bty='n', xpd=NA,c("Observed","Modeled","Predicted","Actual"),fill=c("black","grey","blue","red"))
}
print(paste("Number of function evals: ",dim(search_state$xpins)[1]))
#> [1] "Number of function evals: 847"
We can then convert these search states and the learned surrogates into the initialization of a Scedastic Surrogate Swarm
usevec = c(sample(1:dim(search_state$xpins)[1],ls*2),dim(search_state$xpins)[1])
#usevec = (dim(search_state$xpins)[1]-ls*2):dim(search_state$xpins)[1]
#Swap into particle swarm
swarm_state <- convert_search_to_swarm(search_state = search_state,usevec = usevec,desired_values = ydat,param_len = ls*3,lowlim=lowlim,highlim=highlim,ineq_w = c(),eq_w=c(),config = swarm.config(swarm_size=length(usevec),num_cluster=1,deg=1))
for (itt in 1:20){
tempcontrol = swarm.control(poly_w=0.2,stoch_w = 0.01)
swarm_state <- step_swarm(desired_values = ydat,swarm_state,ineq_w = c(),eq_w=c(),config = swarm.config(swarm_size=length(usevec),num_cluster=1,swarm.control = tempcontrol))
par(oma=c(0, 0, 0, 5))
matplot(xdat,swarm_state$pout,type="l",col="grey",xlab = NULL,ylab="value",ylim = c(0,1.2))
points(xdat,ydat)
surrogate_out <- surrogate_model(as.vector(swarm_state$poly_rec),swarm_state$polyouts,swarm_state$centersaves,deg=1)
lines(xdat,surrogate_out,col="blue")
lines(xdat,model_function(as.vector(swarm_state$poly_rec),ls),col="red")
title("Search-Initialized Scedastic Surrogate Swarm Optimization")
legend(par('usr')[2], par('usr')[4], bty='n',
xpd=NA,c("Observed","Modeled","Predicted","Actual"),fill=c("black","grey","blue","red"))
}
print(paste("Number of function evals: ",dim(swarm_state$allxp)[1]))
#> [1] "Number of function evals: 1667"